;;; Implementation of common dialog window functions

(in-package :gwee)

(defclass modal-dialog (view background-mixin)
  ())

(defun prompt-with-buttons (prompt
                            buttons
                            button-format
                            button-columns
                            submit-check
                            initial-value
                            min max
                            width
                            height
                            x
                            y
			    valid-char-fn)
  (with-layout
      (:views
       (prompt-view text-area
                    :width :maximum
                    :background (gray 230)
                    :border-color nil
                    :data prompt)
       (input text-area
              :background (gwee:gray 255)
              :border-color *default-foreground-color*
              :data (cond
                      ((null initial-value) "")
                      ((stringp initial-value)
                       initial-value)
                      (t (prin1-to-string initial-value)))
              :width :maximum
              :margin-left 5
              :margin-top 3
              :margin-bottom 5
              :vertical-justification :center))
      (:layouts
       (dialog modal-dialog
               (column)
               :background (gray 230)
               :border-color (gray 150)
               :x x
               :y y
               :width width
               :height height)
       (column column-layout
               (prompt-view input)
                    :background (gray 230)
                    :border-color (gray 230)
                    :parent dialog
                    :padding 5
                    :margin 5
                    :height :minimum))
      (:parent *top-view*)
    (let ((button-views (loop for j in buttons
                              collect (make-instance 'button
                                                     :data (funcall button-format j)
                                                     :width :maximum
                                                     :click-callback (let ((val j))
                                                                       (lambda (b)
                                                                         (declare (ignore b))
                                                                         (throw 'done (values (view-data input) val))))))))
      (loop for i = button-views then (subseq i (min (length i) button-columns))
            with first-time = t
            while i
            collect (make-instance 'row-layout
                                   ::height :minimum
                                   :parent column
                                   :margin 1
                                   :margin-top (if first-time 15 1)
                                   :padding 5
                                   :background (gray 230)
                                   :border-color (gray 230)
                                   :subviews (subseq i 0 (min (length i) button-columns)))
            do (setf first-time nil))
      (labels ((update-button ()
                 (let* ((val (view-data input))
                        (enabled (and (or (not min)
                                          (>= (length val) min))
                                      (or (not max)
                                          (<= (length val) max))
                                      (or (not submit-check)
                                          (funcall submit-check val)))))
                   (dolist (i button-views)
                     (setf (disabled-p i) (not enabled))))))
        (update-button)
        (sync-views)
        (draw-view dialog)
        (update-display)
        (unwind-protect
             (catch 'done
               (with-events dialog
                 (add-hook (key-press-hook dialog)
                     (lambda (v key)
                       (declare (ignore v))
                       (let ((ch (key-to-character key)))
                         (when (characterp ch)
                           (case ch
                             (#\Backspace
                              (when (plusp (length (view-data input)))
                                (setf (view-data input) (subseq (view-data input) 0 (1- (length (view-data input))))
                                      (view-needs-update-p input) t)
                                (update-button)))
                             (t
                              (when (and (funcall valid-char-fn ch)
                                         (or (not max)
                                             (< (length (view-data input)) max)))
                                (setf (view-data input) (concatenate 'string (view-data input) (string ch))
                                      (view-needs-update-p input) t)
                                (update-button))))))))
                 (handle-gui-events))))))))

(defun prompt-for-string (prompt &key 
                          (width 300)
                          (height 120)
                          (x (truncate (- (view-width *top-view*) width) 2))
                          (y (truncate (- (view-height *top-view*) height) 2))
                          (ok-text "Ok")
                          ok-check
                          initial-value
			  (valid-char-function 'alphanumericp)
                          min max)
  (prompt-with-buttons prompt (list ok-text) 'identity 1 ok-check initial-value min max width height x y valid-char-function))

(defun display-message-with-buttons (message button-texts &key
                                                           format-function
                                                           (width 305)
                                                           (height 130)
                                                           (x :center)
                                                           (y :center))
  (let* ((dialog (make-instance 'modal-dialog
				:parent gwee:*top-view*
				:background (gray 220)
				:border-color (gray 150)
				:x x
				:y y
				:width width
				:height height))
	 (font (default-font))
	 (fheight (sdl:get-font-height :font font))
	 (text (make-instance 'gwee:text-area
                              :data message
                              :font font
                              :background (gray 220)
                              :parent dialog
                              :x 5
                              :width (- width 10)))
         (row (make-instance 'row-layout
                             :parent dialog
                             :background nil
                             :width :maximum :height :minimum
                             :x :center :y (- height fheight 20)
                             :padding 5))
	 (buttons (loop for text in button-texts
                        collect (make-instance 'gwee:button
                                               :parent row
                                               :font font
                                               :data text
                                               :format-function format-function
                                               :click-callback (lambda (b)
                                                                 (throw 'done (view-data b)))))))
    (declare (ignorable text buttons))
    (sync-views)
    (setf (best-width dialog) (max (view-width dialog)
				   (view-width text))
	  (best-height dialog) (max (view-height dialog)
				    (view-height text)))
    (sync-views)
    (setf (view-y text) (max (truncate (- (view-height dialog) (view-y row) (view-height text)) 2)
                             10))
    (draw-view dialog)
    (update-display)
    (unwind-protect
	 (catch 'done
	   (with-events dialog
	     ;; FIXME: properly draw only the dialog box
	     (gwee:dispatch-events :update-views nil)))
      (delete-view dialog))))

(defun display-message (message &key
			(ok-text "Ok")
			(width 305)
			(height 130)
			(x :center)
			(y :center))
  (display-message-with-buttons message (list ok-text)
                                :width width :height height
                                :x x :y y))

(defun prompt-for-confirmation (prompt &key (width 305) (height 130))
  (string= (display-message-with-buttons prompt (list "Yes" "No")
                                         :width width :height height)
           "Yes"))

(defun die (fmt &rest args)
  (display-message (apply 'format nil fmt args))
  (throw 'quit nil))

;; (defun prompt-for-string (prompt &key 
;;                           (width 300)
;;                           (height 120)
;;                           (x (truncate (- (view-width *top-view*) width) 2))
;;                           (y (truncate (- (view-height *top-view*) height) 2))
;;                           (ok-text "Ok")
;;                           ok-check
;;                           initial-value
;;                           min max)
;;   (let* ((font (open-default-font))
;;          (fheight (sdl-ttf:get-font-height :font font))
;;          (y (truncate (- height (* fheight 3) 35 3) 2))
;;          (input (make-instance 'text-area
;;                                :border-color *default-background-color*
;;                                :data initial-string
;;                                :parent dialog
;;                                :font font
;;                                :width (- width 10)
;;                                :height fheight
;;                                :x 5 :y (+ y fheight 3)))
;;          (dialog (make-instance 'modal-dialog
;;                                 :parent *top-view*
;;                                 :background *light-gray-color*
;;                                 :border-color *gray-color*
;;                                 :x x 
;;                                 :y y
;;                                 :width width
;;                                 :height height
;;                                 :subviews (list
;;                                            (make-instance 'text :data prompt :font font :parent dialog :x 5 :y y)
;;                                            input
;;                                            (make-instance 'button
;;                                                           :parent dialog
;;                                                           :font font
;;                                                           :x 5 :y (+ y (* fheight 2) 10)
;;                                                           :data ok-text
;;                                                           :click-callback (lambda (b)
;;                                                                             (declare (ignore b))
;;                                                                             (throw :done (view-data input))))))))
;;     (labels ((update-button ()
;;                (let ((val (view-data input)))
;;                  (setf (disabled-p ok)
;;                        (and (or (not min)
;;                                 (>= (length val) min))
;;                             (or (not max)
;;                                 (<= (length val) max))
;;                             (or (not ok-check)
;;                                 (funcall ok-check val)))))))
;;       (update-button)
;;       (sdl:update-display)
;;       (unwind-protect
;;            (catch :done
;;              (with-events dialog
;;                (add-hook (key-press-hook dialog)
;;                          (lambda (key)
;;                            (let ((ch (convert-key key)))
;;                              (when (characterp ch)
;;                                (case ch
;;                                  (#\Backspace
;;                                   (when (plusp (length (view-data input)))
;;                                     (setf (view-data input) (subseq (view-data input) 0 (1- (length (view-data input))))
;;                                           (view-needs-update-p input) t)
;;                                     (update-button)))
;;                                  (t
;;                                   (when (and (alphanumericp ch)
;;                                              (or (not max)
;;                                                  (< (length (view-data input)) max)))
;;                                     (setf (view-data input) (concatenate 'string (view-data input) (string ch))
;;                                           (view-needs-update-p input) t)
;;                                     (update-button))))))))
;;                (handle-gui-events)))
;;         (delete-view dialog)))))
